home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 November / Chip Kasım 2000.iso / prog / share / 11 / setup.exe / %MAINDIR% / DEMOS / CIFTP / FTPEXP / servers / mapserve.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-09-07  |  10.7 KB  |  298 lines
  1. VERSION 4.00
  2. Begin VB.Form MapServers 
  3.    BorderStyle     =   4  'Fixed ToolWindow
  4.    Caption         =   "Map FTP Server"
  5.    ClientHeight    =   1740
  6.    ClientLeft      =   1815
  7.    ClientTop       =   2160
  8.    ClientWidth     =   5835
  9.    Height          =   2145
  10.    Icon            =   "MapServe.frx":0000
  11.    Left            =   1755
  12.    LinkTopic       =   "Form1"
  13.    LockControls    =   -1  'True
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   1740
  17.    ScaleWidth      =   5835
  18.    ShowInTaskbar   =   0   'False
  19.    Top             =   1815
  20.    Width           =   5955
  21.    Begin VB.CheckBox chkReconnect 
  22.       Caption         =   "Reconnec&t at logon"
  23.       Height          =   240
  24.       Left            =   960
  25.       TabIndex        =   5
  26.       Top             =   1155
  27.       Width           =   3090
  28.    End
  29.    Begin VB.CommandButton cmdAdd 
  30.       Caption         =   "&Add"
  31.       Height          =   345
  32.       Left            =   135
  33.       TabIndex        =   2
  34.       Top             =   630
  35.       Width           =   1290
  36.    End
  37.    Begin VB.CommandButton cmdRemove 
  38.       Caption         =   "&Remove"
  39.       Enabled         =   0   'False
  40.       Height          =   345
  41.       Left            =   1470
  42.       TabIndex        =   3
  43.       Top             =   630
  44.       Width           =   1290
  45.    End
  46.    Begin VB.CommandButton cmdProperties 
  47.       Caption         =   "&Properties"
  48.       Enabled         =   0   'False
  49.       Height          =   345
  50.       Left            =   2805
  51.       TabIndex        =   4
  52.       Top             =   630
  53.       Width           =   1290
  54.    End
  55.    Begin VB.ComboBox cmbServers 
  56.       Height          =   315
  57.       Left            =   960
  58.       Style           =   2  'Dropdown List
  59.       TabIndex        =   1
  60.       Top             =   180
  61.       Width           =   3135
  62.    End
  63.    Begin VB.CommandButton cmdCancel 
  64.       Cancel          =   -1  'True
  65.       Caption         =   "Cancel"
  66.       Height          =   345
  67.       Left            =   4515
  68.       TabIndex        =   7
  69.       Top             =   630
  70.       Width           =   1125
  71.    End
  72.    Begin VB.CommandButton cmdOK 
  73.       Caption         =   "OK"
  74.       Default         =   -1  'True
  75.       Enabled         =   0   'False
  76.       Height          =   345
  77.       Left            =   4515
  78.       TabIndex        =   6
  79.       Top             =   180
  80.       Width           =   1125
  81.    End
  82.    Begin VB.Label lblGeneric 
  83.       Caption         =   "&Server:"
  84.       Height          =   195
  85.       Index           =   0
  86.       Left            =   180
  87.       TabIndex        =   0
  88.       Top             =   240
  89.       Width           =   675
  90.    End
  91. Attribute VB_Name = "MapServers"
  92. Attribute VB_Creatable = False
  93. Attribute VB_Exposed = False
  94. Option Explicit
  95. '<Public>--------------------------------------------
  96. Public Servers          As Collection
  97. Public ThisExplorer     As Form
  98. Public ThisServer       As FTPServer
  99. Public PressedOK        As Boolean
  100. '</Public>-------------------------------------------
  101. '<Private>------------------------------------------
  102. Private NumberServers   As Integer
  103. '</Private>-----------------------------------------
  104. Private Sub cmbServers_Click()
  105.     cmdRemove.Enabled = True
  106.     cmdProperties.Enabled = True
  107.     cmdOK.Enabled = True
  108.     cmdOK.Default = True
  109.     On Error Resume Next '---- possible after remove
  110.     chkReconnect.Value = GetServer(cmbServers.List(cmbServers.ListIndex)).Reconnect
  111.     On Error GoTo 0
  112. End Sub
  113. Private Sub cmdAdd_Click()
  114.     With Server
  115.         .Mode = ciAdd
  116.         .MyCaption = "Add FTP Server"
  117.         .Show vbModal
  118.         If (Not .PressedOK) Then Exit Sub
  119.         
  120.         '---- add this host to the hosts collection
  121.         On Error GoTo DuplicateKey
  122.         .ThisServer.Reconnect = chkReconnect.Value
  123.         Call Servers.Add(.ThisServer, .ThisServer.Alias)
  124.         
  125.         '---- object.Add(index, key, text, icon, smallIcon)
  126.         cmbServers.AddItem .ThisServer.Alias
  127.         cmbServers.ListIndex = cmbServers.ListCount - 1
  128.     End With
  129.     Exit Sub
  130. DuplicateKey:
  131.     MsgBox "The alias '" & Server.ThisServer.Alias & "' is already in your servers collection.", vbOKOnly + vbInformation, "Add Server Error"
  132. End Sub
  133. Private Sub cmdCancel_Click()
  134.     PressedOK = False
  135.     Unload Me
  136. End Sub
  137. Private Sub cmdOK_Click()
  138.     Dim ListIndex   As Integer
  139.     ListIndex = cmbServers.ListIndex
  140.     '---- if there is no selection just go away like the win explorer net mapping
  141.     If (ListIndex = lbNoSelection) Then
  142.         Set ThisServer = Nothing
  143.         PressedOK = False
  144.     Else
  145.         '---- create the FTP server which will be used by the Explorer
  146.         Set ThisServer = GetServer(cmbServers.List(ListIndex))
  147.         ThisServer.Reconnect = chkReconnect.Value
  148.         PressedOK = True
  149.     End If
  150.     Unload Me
  151. End Sub
  152. Private Sub cmdProperties_Click()
  153.     With Server
  154.         .Mode = ciProperties
  155.         .MyCaption = "FTP Server Properties"
  156.         Set .ThisServer = GetServer(cmbServers.List(cmbServers.ListIndex))
  157.         .Show vbModal
  158.         If (Not .PressedOK) Then Exit Sub
  159.         
  160.         '---- modify the properties
  161.         .ThisServer.Reconnect = chkReconnect.Value
  162.         cmbServers.List(cmbServers.ListIndex) = .ThisServer.Alias
  163.     End With
  164. End Sub
  165. Private Sub cmdRemove_Click()
  166.     Dim ThisNode    As Node
  167.     Dim Alias       As String
  168.     On Error Resume Next '---- should never happen!
  169.     Alias = cmbServers.List(cmbServers.ListIndex)
  170.     Call Servers.Remove(Alias)
  171.     Call cmbServers.RemoveItem(cmbServers.ListIndex)
  172.     '---- remove item from explorer
  173.     Set ThisNode = ThisExplorer.Tree.Nodes.Item("Root.FTPServers." & Alias)
  174.     Call ThisExplorer.RemoveNode(ThisNode)
  175.     On Error GoTo 0
  176.     cmdOK.Enabled = False
  177.     cmdRemove.Enabled = False
  178.     cmdProperties.Enabled = False
  179.     Set ThisNode = Nothing
  180. End Sub
  181. Private Sub Form_Initialize()
  182.     Dim i               As Integer
  183.     Dim PackedServer    As String
  184.     Set Servers = New Collection
  185.     '---- get the hosts from the registry
  186.     NumberServers = Val(GetSetting(App.ProductName, "ciFTPServers", "ciNumberFTPServers"))
  187.     For i = 1 To NumberServers
  188.         PackedServer = GetSetting(App.ProductName, "ciFTPServers", "ciFTPServer" & i)
  189.         Call UnpackServer(PackedServer)
  190.     Next
  191. End Sub
  192. Private Sub Form_Load()
  193.     Dim InstanceServer As FTPServer
  194.     '---- list the servers
  195.     For Each InstanceServer In Servers
  196.         cmbServers.AddItem InstanceServer.Alias
  197.     Next
  198.     If (cmbServers.ListCount > 0) Then cmbServers.ListIndex = 0
  199.     Call CenterForm(Me)
  200. End Sub
  201. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  202.     If (Not (UnloadMode = vbFormCode)) Then
  203.         PressedOK = False
  204.     End If
  205. End Sub
  206. '-----------------------------------------------------
  207. '<Purpose> unpacks a delimited string into an
  208. ' FTPServer class object
  209. '<Note> change this function to retrieve data from
  210. ' any repository
  211. '-----------------------------------------------------
  212. Private Function UnpackServer(PackedAddress As String) As Boolean
  213.     Dim CharPos         As Integer
  214.     Dim ThisServer      As New FTPServer
  215.     Dim Alias           As String
  216.     On Error GoTo BadServer
  217.     CharPos = InStr(PackedAddress, regDelimiter)
  218.     Alias = left(PackedAddress, CharPos - 1)
  219.     ThisServer.Alias = Alias
  220.     PackedAddress = Mid(PackedAddress, CharPos + 1)
  221.     CharPos = InStr(PackedAddress, regDelimiter)
  222.     ThisServer.HostName = left(PackedAddress, CharPos - 1)
  223.     PackedAddress = Mid(PackedAddress, CharPos + 1)
  224.     CharPos = InStr(PackedAddress, regDelimiter)
  225.     ThisServer.HostAddress = left(PackedAddress, CharPos - 1)
  226.     PackedAddress = Mid(PackedAddress, CharPos + 1)
  227.     CharPos = InStr(PackedAddress, regDelimiter)
  228.     ThisServer.LoginName = left(PackedAddress, CharPos - 1)
  229.     PackedAddress = Mid(PackedAddress, CharPos + 1)
  230.     CharPos = InStr(PackedAddress, regDelimiter)
  231.     ThisServer.Password = left(PackedAddress, CharPos - 1)
  232.     PackedAddress = Mid(PackedAddress, CharPos + 1)
  233.     CharPos = InStr(PackedAddress, regDelimiter)
  234.     ThisServer.Reconnect = Val(left(PackedAddress, CharPos - 1))
  235.     PackedAddress = Mid(PackedAddress, CharPos + 1)
  236.     ThisServer.ServerType = Val(PackedAddress)
  237.     Call Servers.Add(ThisServer, Alias)
  238.     UnpackServer = True
  239. Cleanup:
  240.     Set ThisServer = Nothing
  241.     Exit Function
  242. BadServer:
  243.     MsgBox "An error occurred while unpacking an FTP Server: " & Err.Description, vbOKOnly + vbInformation
  244.     UnpackServer = False
  245.     GoTo Cleanup
  246. End Function
  247. '------------------------------------------------------
  248. '<Purpose> returns an FTPServer class object
  249. '------------------------------------------------------
  250. Public Function GetServer(Alias As String) As FTPServer
  251.     On Error GoTo BadItem
  252.     Set GetServer = Servers.Item(Alias)
  253.     On Error GoTo 0
  254.     Exit Function
  255. BadItem:
  256.     Set GetServer = Nothing
  257.     On Error GoTo 0
  258. End Function
  259. '-----------------------------------------------------
  260. '<Purpose> packs a FTPServer class object into a
  261. ' delimited string for storage in the registry
  262. '<Note> change this function to store data in any
  263. ' repository such as a relational DB
  264. '-----------------------------------------------------
  265. Private Function PackServer(ThisServer As FTPServer) As String
  266.     Dim Temp        As String
  267.     Temp = ThisServer.Alias & regDelimiter
  268.     Temp = Temp & ThisServer.HostName & regDelimiter
  269.     Temp = Temp & ThisServer.HostAddress & regDelimiter
  270.     Temp = Temp & ThisServer.LoginName & regDelimiter
  271.     Temp = Temp & ThisServer.Password & regDelimiter
  272.     Temp = Temp & ThisServer.Reconnect & regDelimiter
  273.     Temp = Temp & ThisServer.ServerType
  274.     PackServer = Temp
  275. End Function
  276. Private Sub Form_Terminate()
  277.     Dim i   As Integer
  278.     NumberServers = Servers.Count
  279.     For i = 1 To NumberServers
  280.         Call SaveSetting(App.ProductName, "ciFTPServers", "ciFTPServer" & i, PackServer(Servers(i)))
  281.     Next
  282.     'SaveSetting(appname, section, key, setting)
  283.     Call SaveSetting(App.ProductName, "ciFTPServers", "ciNumberFTPServers", NumberServers)
  284.     '---- explicitly clean up all object
  285.     Set Servers = Nothing
  286.     Set ThisServer = Nothing
  287. End Sub
  288. '------------------------------------------------------
  289. '<Purpose> turns off the "Reconnect" bit on a server
  290. '------------------------------------------------------
  291. Public Sub Disconnect(Alias As String)
  292.     Dim ThisServer As FTPServer
  293.     Set ThisServer = GetServer(Alias)
  294.     ThisServer.Reconnect = 0
  295.         
  296.     Set ThisServer = Nothing
  297. End Sub
  298.